VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ExExport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2001                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
'local variable(s) to hold property value(s)
Private mvarClassID As String 'local copy
Private mvarDescription As String 'local copy
Private mvarInfo As String 'local copy
Private mvarLastError As String 'local copy
Dim ExApp As Excel.Application
Dim pWbs As Workbooks
Dim pWb As Workbook
Dim pWss As Worksheets
Dim pWs As Worksheet
Private Init1 As Boolean
Dim nGraphicsCount As Long
Dim Grs As Graphics
Public Property Get Info() As String
        Info = "MSEExport.ExExport,SDK sample filter Microsoft Excel File,0,10,xls,xls"
End Property

Public Function Initialize(ByVal ThisFilter As Object) As Boolean
    Initialize = True
End Function

Public Function WriteSetup(ByVal ThisFilter As Object) As Boolean
    ' setup setting for our filter
 
    'MsgBox "Not implemented yet. " & vbCrLf & "Add your code here !"
    MsgBox "Not implemented. " & vbCrLf & "You can add the code yourself.", , "XLS file export"

End Function


Public Function WriteFlat(ByVal FileName As String, ByVal Aspect As Long, ByVal Graphics As Object, Optional Query As Variant) As Long
On Error GoTo ExcelWontInit
    
' Create Microsoft Excel application
    Set ExApp = CreateObject("Excel.Application")
    Set pWbs = ExApp.Workbooks
' create new workbook
    Set pWb = pWbs.Add
    Set pWs = pWb.Worksheets(1) '.Add
    Set Grs = Graphics
    nGraphicsCount = Grs.Count
    ' fill timesheet with graphic's data
    Call Fill_Sheet(pWs, "Graphic's properties")
    
    Set Grs = Nothing
    pWb.SaveAs FileName ', , , , , , xlShared
    pWb.Close
    pWbs.Close
    
    ExApp.Quit
    
    Set pWs = Nothing
    Set pWb = Nothing
    Set pWbs = Nothing
    Set ExApp = Nothing
    Exit Function
ExcelWontInit:
    MsgBox "Can't initiaize Excel Application. Probably there is not Excel installed !"
    MsgBox Err.Description
    Err.Clear
    If Not ExApp Is Nothing Then
        ExApp.Quit
    End If
    
    Set pWs = Nothing
    Set pWb = Nothing
    Set pWbs = Nothing
    Set ExApp = Nothing
End Function

Public Function PreviewFlat(ByVal ThisFilter As Object, ByVal FileName As String, ByVal WidthA As Long, ByVal HeightA As Long, Description As String, Thumbnail As Variant) As Long
    PreviewFlat = -1
End Function

Public Function CheckFlat(ByVal ThisFilter As Object, ByVal FileName As String, ByVal Aspect As Long, ByVal Query As Variant) As Long
End Function

Public Property Get LastError() As String
Attribute LastError.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.LastError
    LastError = mvarLastError
End Property

' GetInfo:  return the filter's info string
' Our info string is "MSEExport.Excel,Microsoft Excel File,0,10,xls,xls", stored in the DLL's
' resource.

' The info string contains the following fields, delimited by commas:
' Field Name                                Value
' 1.    Filter ID                           "MSEExport.Excel"
' the Filter ID must contains 32 symbols not more'
' otherwise your custom filter will not registered properly by turboCAD
'        Used as the internal name (must be unique).
'        Should be the same as the ProgID registered for the server.
'        TurboCAD reserves names beginning with an asterisk.
' 2.    File type string for common dialog  "Microsoft Excel File";
'        This string appears in Windows dialog file type combo box.
' 3.    Document type handled by filter     0
'        This should always be zero for automation filters.
' 4.    Priority                            10
'        Arbitrary integer value used to determine search order for multiple filters which
'        support the same document type and file extension.
' 5.    Exported function name prefix       "xls"
'        Not used by automation filters, but a non-blank string must be supplied.
' 6-n.  File extensions                     "xls"
'        Used in common dialog and for matching.


Public Property Get Description() As String
Attribute Description.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Description
    Description = mvarDescription
End Property


Public Property Get ClassID() As String
Attribute ClassID.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.ClassID
    ClassID = mvarClassID
End Property
Private Sub Fill_Sheet(W As Worksheet, SheetName As String)
    ' declare array to store graphic's data
    Dim InfoArray() As String
    Dim i As Long
    Dim j As Long
    Dim Gr As Graphic
  
    W.Name = SheetName '"Graphic's properties"
    
' adjust array size in accordance with count of graphics and count of graphic properties to be exported
' in this example we export values of 5 properties for each graphic
' so array is nGraphicsCount x 5
    ReDim InfoArray(nGraphicsCount, 5)
' first row in this array store Property Name (Column name in Excel spreadsheet)
    InfoArray(0, 0) = "GraphicType"
    InfoArray(0, 1) = "GraphicInfo"
    InfoArray(0, 2) = "PenColor"
    InfoArray(0, 3) = "PenStyle"
    InfoArray(0, 4) = "Layer"
    InfoArray(0, 5) = "GraphicID"
    On Error Resume Next
    ' fill array
    i = 0
    j = 0
     For Each Gr In Grs
            Set Gr = Grs(i)
            InfoArray(i + 1, j) = Gr.Type
            InfoArray(i + 1, j + 1) = Gr.Properties("Info")
            InfoArray(i + 1, j + 2) = Gr.Properties("PenColor")
            InfoArray(i + 1, j + 3) = Gr.Properties("PenStyle")
            InfoArray(i + 1, j + 4) = Gr.Properties("Layer")
            InfoArray(i + 1, j + 5) = Gr.ID
            i = i + 1
    Next
    
    i = 0
    j = 0
    
    For i = 0 To nGraphicsCount
        W.Cells(i + 1, j + 1) = InfoArray(i, j)
        For j = 1 To 5
            W.Cells(1, 1).Colo
            W.Cells(i + 1, j + 1) = InfoArray(i, j)
        Next j
        j = 0
    Next i
    W.Columns.AutoFit

End Sub

